home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / while.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  7.1 KB  |  320 lines  |  [TEXT/ALFA]
  1. # Commands covered:  while
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1996 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. # SCCS: @(#) @(#) while.test 1.9 97/07/02 16:41:35
  13.  
  14. if {[string compare test [info procs test]] == 1} then {source defs}
  15.  
  16. # Basic "while" operation.
  17.  
  18. catch {unset i}
  19. catch {unset a}
  20.  
  21. test while-1.1 {TclCompileWhileCmd: missing test expression} {
  22.     catch {while } msg
  23.     set msg
  24. } {wrong # args: should be "while test command"}
  25. test while-1.2 {TclCompileWhileCmd: error in test expression} {
  26.     set i 0
  27.     catch {while {$i<}} msg
  28.     set errorInfo
  29. } {syntax error in expression "$i<"
  30.     ("while" test expression)
  31.     while compiling
  32. "while {$i<}"}
  33. test while-1.3 {TclCompileWhileCmd: error in test expression} {
  34.     set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
  35.     list $err $msg
  36. } {1 {can't use non-numeric string as operand of "+"}}
  37. test while-1.4 {TclCompileWhileCmd: multiline test expr} {
  38.     set value 1
  39.     while {($tcl_platform(platform) != "foobar1") && \
  40.         ($tcl_platform(platform) != "foobar2")} {
  41.         incr value
  42.         break
  43.     }
  44.     set value
  45. } {2}
  46. test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
  47.     set value 1
  48.     while {"true"} {
  49.     incr value;
  50.     if {$value > 5} {
  51.         break;
  52.     }
  53.     }
  54.     set value
  55. } 6
  56. test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
  57.     set i 0
  58.     while "$i > 5" {}
  59. } {}
  60. test while-1.7 {TclCompileWhileCmd: missing command body} {
  61.     set i 0
  62.     catch {while {$i < 5} } msg
  63.     set msg
  64. } {wrong # args: should be "while test command"}
  65. test while-1.8 {TclCompileWhileCmd: error compiling command body} {
  66.     set i 0
  67.     catch {while {$i < 5} {set}} msg
  68.     set errorInfo
  69. } {wrong # args: should be "set varName ?newValue?"
  70.     while compiling
  71. "set"
  72.     ("while" body line 1)
  73.     while compiling
  74. "while {$i < 5} {set}"}
  75. test while-1.9 {TclCompileWhileCmd: simple command body} {
  76.     set a {}
  77.     set i 1
  78.     while {$i<6} {
  79.     if $i==4 break
  80.     set a [concat $a $i]
  81.         incr i
  82.     }
  83.     set a
  84. } {1 2 3}
  85. test while-1.10 {TclCompileWhileCmd: command body in quotes} {
  86.     set a {}
  87.     set i 1
  88.     while {$i<6} "append a x; incr i"
  89.     set a
  90. } {xxxxx}
  91. test while-1.11 {TclCompileWhileCmd: computed command body} {
  92.     catch {unset x1}
  93.     catch {unset bb}
  94.     catch {unset x2}
  95.     set x1 {append a x1; }
  96.     set bb {break}
  97.     set x2 {; append a x2; incr i}
  98.     set a {}
  99.     set i 1
  100.     while {$i<6} $x1$bb$x2
  101.     set a
  102. } {x1}
  103. test while-1.12 {TclCompileWhileCmd: long command body} {
  104.     set a {}
  105.     set i 1
  106.     while {$i<6} {
  107.     if $i==4 break
  108.     if $i>5 continue
  109.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  110.         catch {set a $a} msg
  111.         catch {incr i 5} msg
  112.         catch {incr i -5} msg
  113.     }
  114.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  115.         catch {set a $a} msg
  116.         catch {incr i 5} msg
  117.         catch {incr i -5} msg
  118.     }
  119.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  120.         catch {set a $a} msg
  121.         catch {incr i 5} msg
  122.         catch {incr i -5} msg
  123.     }
  124.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  125.         catch {set a $a} msg
  126.         catch {incr i 5} msg
  127.         catch {incr i -5} msg
  128.     }
  129.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  130.         catch {set a $a} msg
  131.         catch {incr i 5} msg
  132.         catch {incr i -5} msg
  133.     }
  134.     set a [concat $a $i]
  135.         incr i
  136.     }
  137.     set a
  138. } {1 2 3}
  139. test while-1.13 {TclCompileWhileCmd: while command result} {
  140.     set i 0
  141.     set a [while {$i < 5} {incr i}]
  142.     set a
  143. } {}
  144. test while-1.14 {TclCompileWhileCmd: while command result} {
  145.     set i 0
  146.     set a [while {$i < 5} {if $i==3 break; incr i}]
  147.     set a
  148. } {}
  149.  
  150. # Check "while" and "continue".
  151.  
  152. test while-2.1 {continue tests} {
  153.     set a {}
  154.     set i 1
  155.     while {$i <= 4} {
  156.         incr i
  157.     if {$i == 3} continue
  158.     set a [concat $a $i]
  159.     }
  160.     set a
  161. } {2 4 5}
  162. test while-2.2 {continue tests} {
  163.     set a {}
  164.     set i 1
  165.     while {$i <= 4} {
  166.         incr i
  167.     if {$i != 2} continue
  168.     set a [concat $a $i]
  169.     }
  170.     set a
  171. } {2}
  172. test while-2.3 {continue tests, nested loops} {
  173.     set msg {}
  174.     set i 1
  175.     while {$i <= 4} {
  176.         incr i
  177.         set a 1
  178.     while {$a <= 2} {
  179.             incr a
  180.             if {$i>=3 && $a>=3} continue
  181.             set msg [concat $msg "$i.$a"]
  182.         }
  183.     }
  184.     set msg
  185. } {2.2 2.3 3.2 4.2 5.2}
  186. test while-2.4 {continue tests, long command body} {
  187.     set a {}
  188.     set i 1
  189.     while {$i<6} {
  190.     if $i==2 {incr i; continue}
  191.     if $i==4 break
  192.     if $i>5 continue
  193.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  194.         catch {set a $a} msg
  195.         catch {incr i 5} msg
  196.         catch {incr i -5} msg
  197.     }
  198.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  199.         catch {set a $a} msg
  200.         catch {incr i 5} msg
  201.         catch {incr i -5} msg
  202.     }
  203.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  204.         catch {set a $a} msg
  205.         catch {incr i 5} msg
  206.         catch {incr i -5} msg
  207.     }
  208.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  209.         catch {set a $a} msg
  210.         catch {incr i 5} msg
  211.         catch {incr i -5} msg
  212.     }
  213.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  214.         catch {set a $a} msg
  215.         catch {incr i 5} msg
  216.         catch {incr i -5} msg
  217.     }
  218.     set a [concat $a $i]
  219.         incr i
  220.     }
  221.     set a
  222. } {1 3}
  223.  
  224. # Check "while" and "break".
  225.  
  226. test while-3.1 {break tests} {
  227.     set a {}
  228.     set i 1
  229.     while {$i <= 4} {
  230.     if {$i == 3} break
  231.     set a [concat $a $i]
  232.         incr i
  233.     }
  234.     set a
  235. } {1 2}
  236. test while-3.2 {break tests, nested loops} {
  237.     set msg {}
  238.     set i 1
  239.     while {$i <= 4} {
  240.         set a 1
  241.     while {$a <= 2} {
  242.             if {$i>=2 && $a>=2} break
  243.             set msg [concat $msg "$i.$a"]
  244.             incr a
  245.         }
  246.         incr i
  247.     }
  248.     set msg
  249. } {1.1 1.2 2.1 3.1 4.1}
  250. test while-3.3 {break tests, long command body} {
  251.     set a {}
  252.     set i 1
  253.     while {$i<6} {
  254.     if $i==2 {incr i; continue}
  255.     if $i==5 break
  256.     if $i>5 continue
  257.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  258.         catch {set a $a} msg
  259.         catch {incr i 5} msg
  260.         catch {incr i -5} msg
  261.     }
  262.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  263.         catch {set a $a} msg
  264.         catch {incr i 5} msg
  265.         catch {incr i -5} msg
  266.     }
  267.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  268.         catch {set a $a} msg
  269.         catch {incr i 5} msg
  270.         catch {incr i -5} msg
  271.     }
  272.     if $i==4 break
  273.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  274.         catch {set a $a} msg
  275.         catch {incr i 5} msg
  276.         catch {incr i -5} msg
  277.     }
  278.     if {$i>6 && $tcl_platform(machine)=="xxx"} {
  279.         catch {set a $a} msg
  280.         catch {incr i 5} msg
  281.         catch {incr i -5} msg
  282.     }
  283.     set a [concat $a $i]
  284.         incr i
  285.     }
  286.     set a
  287. } {1 3}
  288.  
  289. # Check "while", "break", "continue" and computed command names.
  290.  
  291. test while-4.1 {while and computed command names} {
  292.     set i 0
  293.     set z while
  294.     $z {$i < 10} {
  295.         incr i
  296.     }
  297.     set i
  298. } 10
  299.  
  300. test while-5.1 {break and computed command names} {
  301.     set i 0
  302.     set z break
  303.     while 1 {
  304.         if {$i > 10} $z
  305.         incr i
  306.     }
  307.     set i
  308. } 11
  309.  
  310. test while-6.1 {continue and computed command names} {
  311.     set i 0
  312.     set z continue
  313.     while 1 {
  314.         incr i
  315.         if {$i < 10} $z
  316.         break
  317.     }
  318.     set i
  319. } 10
  320.